perm filename H[AP,DBL] blob sn#100584 filedate 1974-05-06 generic text, type T, neo UTF8
(FILECREATED " 6-MAY-74 21:47:11" H

     changes to:  DETERMINE:ALL:ARG:VALUES, DETERMINE:ALL:ARG2:VALUES, DETERMINE:ALL:ARG3:VALUES, 
INSERT:PRINT:STATEMENTS)


(DEFINEQ

(DETERMINE:ALL:ARG:VALUES
  (LAMBDA (CHOICE1 ENT2 LARG1 HOLD:ANY2)
    (SETQ LARG1 NIL)
    (SETQ ENT2 (MAPCONC TRUE:FN:CALL:LIST (FUNCTION (LAMBDA (TFC)
                            (COND
                              ((EQUAL (CAR TFC)
                                      (CADR CHOICE1))
                                (LIST (CADR TFC))))))))
    (COND
      ((NULL ENT2)
        (SOME TRUE:FN:CALL:LIST (FUNCTION (LAMBDA (TF)
                  (COND
                    ((MATCH (TUPLE FRAG1 ANY1 ANY2 (CADR CHOICE1))
                            TF)
                      (SETQ ENT2 (CONS ANY1 ENT2)))))))))
    (SETQ LARG1 (MAPCAR ENT2 (FUNCTION (LAMBDA (ENT3)
                            (COND
                              ((SOME TYPE:OF:LIST (FUNCTION (LAMBDA (TOL)
                                         (COND
                                           ((MATCH (VECTOR ANY2 TYPE OF (LIST VECTOR ENT3)
                                                           IS ANY3 AND IS USED IN (CADR CHOICE1))
                                                   TOL)
                                             ANY2))))))
                              (ENT3))))))
    (COND
      ((EQUAL LARG1 NIL)
        (SETQ LARG1 ENT2)))
    (SETQ LARG1 (MAPCONC LARG1 (FUNCTION (LAMBDA (SMALL:LARG1)
                             (COND
                               ((MATCH (TUPLE A R G ANY2)
                                       (UNPACK SMALL:LARG1))
                                 (SETQ HOLD:ANY2 NIL)
                                 (SOME TYPE:OF:LIST (FUNCTION (LAMBDA (TOL2)
                                           (COND
                                             ((MATCH (VECTOR (CADR CHOICE1)
                                                             TYPE OF FRAG2 USED IN ANY2)
                                                     TOL2)
                                               (SETQ HOLD:ANY2 ANY2))))))
                                 (COND
                                   ((NULL HOLD:ANY2)
                                     (LIST SMALL:LARG1))
                                   ((EQUAL SMALL:LARG1 (QUOTE ARG1))
                                     (DETERMINE:ALL:ARG:VALUES (LIST VECTOR HOLD:ANY2)))
                                   (T (DETERMINE:ALL:ARG2:VALUES (LIST VECTOR HOLD:ANY2)))))
                               (T (LIST SMALL:LARG1)))))))))

(DETERMINE:ALL:ARG2:VALUES
  (LAMBDA (CHOICE1 ENT2 HOLD:ANY2 LARG2)
    (SETQ LARG2 NIL)
    (SETQ ENT2 (MAPCONC TRUE:FN:CALL:LIST (FUNCTION (LAMBDA (TFC)
                            (COND
                              ((EQUAL (CAR TFC)
                                      (CADR CHOICE1))
                                (LIST (CADDR TFC))))))))
    (COND
      ((NULL ENT2)
        (SOME TRUE:FN:CALL:LIST (FUNCTION (LAMBDA (TF)
                  (COND
                    ((MATCH (TUPLE FRAG1 ANY2 ANY1 (CADR CHOICE1))
                            TF)
                      (SETQ ENT2 (CONS ANY1 ENT2)))))))))
    (SETQ LARG2 (MAPCAR ENT2 (FUNCTION (LAMBDA (ENT3)
                            (COND
                              ((SOME TYPE:OF:LIST (FUNCTION (LAMBDA (TOL)
                                         (COND
                                           ((MATCH (VECTOR ANY2 TYPE OF (LIST VECTOR ENT3)
                                                           IS ANY3 AND IS USED IN (CADR CHOICE1))
                                                   TOL)
                                             ANY2))))))
                              (ENT3))))))
    (COND
      ((EQUAL LARG2 NIL)
        (SETQ LARG2 ENT2)))
    (SETQ LARG2 (MAPCONC LARG2 (FUNCTION (LAMBDA (SMALL:LARG2)
                             (COND
                               ((MATCH (TUPLE A R G ANY2)
                                       (UNPACK SMALL:LARG2))
                                 (SETQ HOLD:ANY2 NIL)
                                 (SOME TYPE:OF:LIST (FUNCTION (LAMBDA (TOL2)
                                           (COND
                                             ((MATCH (VECTOR (CADR CHOICE1)
                                                             TYPE OF FRAG2 USED IN ANY2)
                                                     TOL2)
                                               (SETQ HOLD:ANY2 ANY2))))))
                                 (COND
                                   ((NULL HOLD:ANY2)
                                     (LIST SMALL:LARG2))
                                   ((EQUAL SMALL:LARG2 (QUOTE ARG1))
                                     (DETERMINE:ALL:ARG:VALUES (LIST VECTOR HOLD:ANY2)))
                                   (T (DETERMINE:ALL:ARG2:VALUES (LIST VECTOR HOLD:ANY2)))))
                               (T (LIST SMALL:LARG2)))))))))

(DETERMINE:ALL:ARG3:VALUES
  (LAMBDA (CHOICE1 ENT2 HOLD:ANY2 LARG3)
    (SETQ LARG3 NIL)
    (SETQ ENT2 (MAPCONC TRUE:FN:CALL:LIST (FUNCTION (LAMBDA (TFC)
                            (COND
                              ((EQUAL TFC (CADR CHOICE))
                                (LIST (CADDDR TFC))))))))
    (COND
      ((NULL ENT2)
        (SOME TRUE:FN:CALL:LIST (FUNCTION (LAMBDA (TF)
                  (COND
                    ((MATCH (TUPLE FRAG1 ANY2 ANY1 (CADR CHOICE1))
                            TF)
                      (SETQ ENT2 (PACK (LIST (QUOTE AN:ELEMENT:OF:)
                                             ANY1))))))))))
    (SOME TYPE:OF:LIST (FUNCTION (LAMBDA (TOL)
              (MAPC ENT2 (FUNCTION (LAMBDA (ENT3)
                        (COND
                          ((MATCH (VECTOR ANY2 TYPE OF (LIST VECTOR ENT3)
                                          IS ANY2 AND IS USED IN (CADR CHOICE1))
                                  TOL)
                            (SETQ LARG3 (CONS ANY2 LARG3))))))))))
    (COND
      ((EQUAL LARG3 NIL)
        (SETQ LARG3 ENT2)))
    (SETQ LARG3 (MAPCONC LARG3 (FUNCTION (LAMBDA (SMALL:LARG3)
                             (COND
                               ((MATCH (TUPLE A R G ANY2)
                                       (UNPACK SMALL:LARG3))
                                 (SETQ HOLD:ANY2 NIL)
                                 (SOME TYPE:OF:LIST (FUNCTION (LAMBDA (TOL2)
                                           (COND
                                             ((MATCH (VECTOR (CADR CHOICE1)
                                                             TYPE OF FRAG2 USED IN ANY2)
                                                     TOL2)
                                               (SETQ HOLD:ANY2 ANY2))))))
                                 (COND
                                   ((NULL HOLD:ANY2)
                                     (LIST SMALL:LARG3))
                                   ((EQUAL SMALL:LARG3 (QUOTE ARG1))
                                     (DETERMINE:ALL:ARG:VALUES (LIST VECTOR HOLD:ANY2)))
                                   (T (DETERMINE:ALL:ARG2:VALUES (LIST VECTOR HOLD:ANY2)))))
                               (T (LIST SMALL:LARG3)))))))))

(INSERT:PRINT:STATEMENTS
  (LAMBDA NIL
    (PUPRIN1 " SORRY, I AM INSERTING THE PRINT STATMENTS BY OMNISCIENCE ")
    (PUT PAD:2 META:CODE (SUBST (QUOTE (AND (FOREACH (QUOTE NAME)
                                                     IN SET:OF:POSSIBLE:NAMES:OF:CLASS DO
                                                     (QUOTE (PROGN (PUPRINT NAME)
                                                                   (COND
                                                                     ((GETP NAME CLASS:OBJECTS:33)
                                                                       (PUPRIN1 "OBJECTS ")
                                                                       (PUPRINT (GETP NAME CLASS:OBJECTS:33))))
                                                                   (COND
                                                                     ((GETP NAME CLASS:YES:RELNS:35)
                                                                       (PUPRIN1 "MUST HAVE ")
                                                                       (PUPRINT (GETP NAME CLASS:YES:RELNS:35))))
                                                                   (COND
                                                                     ((GETP NAME CLASS:NO:RELNS:36)
                                                                       (PUPRIN1 "MUSNT HAVE ")
                                                                       (PUPRINT (GETP NAME CLASS:NO:RELNS:36))))
                                                                   (COND
                                                                     ((GETP NAME CLASS:MAYBE:RELNS:37)
                                                                       (PUPRIN1 "MAY HAVE ")
                                                                       (PUPRINT (GETP NAME CLASS:MAYBE:RELNS:37))))
                                                                   (TERPRI)
                                                                   T)))
                                            (GO LABEL:1)))
                                (QUOTE (GO LABEL:1))
                                (COPY (GETP PAD:2 META:CODE))))))
)
  (LISPXPRINT (QUOTE HFNS)
              T)
  (RPAQQ HFNS (DETERMINE:ALL:ARG:VALUES DETERMINE:ALL:ARG2:VALUES DETERMINE:ALL:ARG3:VALUES INSERT:PRINT:STATEMENTS))
STOP